home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / PowerMacOberon feb96 / Source / Oberon.Mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1995-07-14  |  11.7 KB  |  326 lines  |  [TEXT/.Ob4]
  1. Syntax10.Scn.Fnt
  2. StampElems
  3. Alloc
  4. 14 Jul 95
  5. MODULE Oberon;    (* mf 24.9.93 / mah 
  6.     IMPORT
  7.         SYSTEM, Kernel, Sys, Macintosh, Modules, Input, Display, Fonts, Viewers, Texts;
  8.     CONST
  9.         consume*= 0; track*= 1; (*message ids*)
  10.         defocus*= 0; neutralize*= 1; mark*= 2; (*message ids*)
  11.         BasicCycle= 20;
  12.     TYPE
  13.         Painter*= PROCEDURE(x, y: INTEGER);
  14.         Marker*= RECORD Fade*, Draw*: Painter END;
  15.         Cursor* = RECORD
  16.             marker*: Marker; on*: BOOLEAN; X*, Y*: INTEGER
  17.         END;
  18.         ParList*= POINTER TO ParRec;
  19.         ParRec*= RECORD
  20.             vwr*: Viewers.Viewer;
  21.             frame*: Display.Frame;
  22.             text*: Texts.Text;
  23.             pos*: LONGINT
  24.         END;
  25.         InputMsg*= RECORD (Display.FrameMsg)
  26.             id*: INTEGER;
  27.             keys*: SET;
  28.             X*, Y*: INTEGER;
  29.             ch*: CHAR;
  30.             fnt*: Fonts.Font;
  31.             col*, voff*: SHORTINT
  32.         END;
  33.         SelectionMsg*= RECORD (Display.FrameMsg)
  34.             time*: LONGINT;
  35.             text*: Texts.Text;
  36.             beg*, end*: LONGINT
  37.         END;
  38.         ControlMsg* = RECORD (Display.FrameMsg)
  39.             id*, X*, Y*: INTEGER
  40.         END;
  41.         CopyOverMsg*= RECORD (Display.FrameMsg)
  42.             text*: Texts.Text;
  43.             beg*, end*: LONGINT
  44.         END;
  45.         CopyMsg*= RECORD (Display.FrameMsg)
  46.             F*: Display.Frame
  47.         END;
  48.         Handler*= PROCEDURE;
  49.         Task*= POINTER TO TaskDesc;
  50.         TaskDesc*= RECORD
  51.             next: Task;
  52.             safe*: BOOLEAN;
  53.             time*: LONGINT;
  54.             handle*: Handler
  55.         END;
  56.         User*: ARRAY 8 OF CHAR;
  57.         Password*: LONGINT;
  58.         Arrow*, Star*: Marker;
  59.         Mouse*, Pointer*: Cursor;
  60.         FocusViewer*: Viewers.Viewer;
  61.         Log*: Texts.Text;
  62.         Par*: ParList; (* actual parameters *)
  63.         CurTask*, PrevTask: Task;
  64.         CurFnt*: Fonts.Font; CurCol*, CurOff*: SHORTINT;
  65.         DW, DH, H0, H1, H2, H3, H4, unitW: INTEGER;
  66.         ActCnt: INTEGER; (* Action Count for GC *)
  67.         SystemMod: Modules.Module;
  68.         arrowFade: Painter;
  69.         MPar: ParList;
  70.     (* User Identification *)
  71.         PROCEDURE Code(VAR s: ARRAY OF CHAR): LONGINT;
  72.             VAR i: INTEGER; a, b, c: LONGINT;
  73.         BEGIN a:=0; b:=0; i:=0;
  74.             WHILE s[i]#0X DO c:=b; b:=a; a:=(c MOD 509+1)*127+ORD(s[i]); INC(i) END;
  75.             IF b >= 32768 THEN b := b-65536 END;
  76.             RETURN b*65536+a
  77.         END Code;
  78.         PROCEDURE SetUser*(VAR user, password: ARRAY OF CHAR);
  79.         BEGIN COPY(user, User); Password:=Code(password)
  80.         END SetUser;
  81.     (* Clocks *)
  82.         PROCEDURE GetClock*(VAR t, d: LONGINT);
  83.         VAR secs: LONGINT;
  84.         BEGIN Sys.GetDateTime (secs); Sys.ConvertTime (secs, t, d);
  85.         END GetClock;
  86.         PROCEDURE SetClock*(t, d: LONGINT);
  87.         BEGIN Sys.SetClock(t, d)
  88.         END SetClock;
  89.         PROCEDURE Time*(): LONGINT;
  90.         BEGIN RETURN Input.Time()
  91.         END Time;
  92.     (* Cursor Handling *)
  93.         PROCEDURE* FlipArrow(X, Y: INTEGER);
  94.         END FlipArrow;
  95.         PROCEDURE* FlipStar(X, Y: INTEGER);
  96.         BEGIN
  97.             IF X < 7 THEN X:=7 ELSIF X > DW-8 THEN Y:=DW-8 END;
  98.             IF Y < 7 THEN Y:=7 ELSIF Y > DH-8 THEN Y:=DH-8 END;
  99.             Display.CopyPattern(Display.white, Display.star, X-7, Y-7, Display.invert)
  100.         END FlipStar;
  101.         PROCEDURE OpenCursor*(VAR c: Cursor);
  102.         BEGIN c.on:=FALSE; c.X:=0; c.Y:=0
  103.         END OpenCursor;
  104.         PROCEDURE FadeCursor*(VAR c: Cursor);
  105.         BEGIN IF c.on THEN c.marker.Fade(c.X, c.Y); c.on:=FALSE END
  106.         END FadeCursor;
  107.         PROCEDURE DrawCursor*(VAR c: Cursor; VAR m: Marker; X, Y: INTEGER);
  108.         BEGIN
  109.             IF c.on & ((X#c.X) OR (Y#c.Y) OR (m.Draw#c.marker.Draw)) THEN c.marker.Fade(c.X, c.Y); c.on:=FALSE END;
  110.             IF c.marker.Fade=arrowFade THEN
  111.                 IF m.Fade#arrowFade THEN Sys.HideCursor END
  112.             ELSE
  113.                 IF m.Fade=arrowFade THEN Sys.ShowCursor END
  114.             END;
  115.             IF ~c.on THEN m.Draw(X, Y); c.marker:=m; c.X:=X; c.Y:=Y; c.on:=TRUE END
  116.         END DrawCursor;
  117.     (* Display Management *)
  118.         PROCEDURE RemoveMarks*(X, Y, W, H: INTEGER);
  119.         BEGIN
  120.             IF (Mouse.X > X-16) & (Mouse.X < X+W+16) & (Mouse.Y > Y-16) & (Mouse.Y < Y+H+16) THEN FadeCursor(Mouse) END;
  121.             IF (Pointer.X > X-8) & (Pointer.X < X+W+8) & (Pointer.Y > Y-8) & (Pointer.Y < Y+H+8) THEN FadeCursor(Pointer) END
  122.         END RemoveMarks;
  123.         PROCEDURE* HandleFiller(V: Display.Frame; VAR M: Display.FrameMsg);
  124.         BEGIN
  125.             WITH V: Viewers.Viewer DO
  126.                 IF M IS InputMsg THEN
  127.                     WITH M: InputMsg DO
  128.                         IF M.id=track THEN DrawCursor(Mouse, Arrow, M.X, M.Y) END
  129.                     END
  130.                 ELSIF M IS ControlMsg THEN
  131.                     WITH M: ControlMsg DO
  132.                         IF M.id=mark THEN DrawCursor(Pointer, Star, M.X, M.Y) END
  133.                     END
  134.                 ELSIF M IS Viewers.ViewerMsg THEN
  135.                     WITH M: Viewers.ViewerMsg DO
  136.                         IF (M.id=Viewers.restore) & (V.W > 0) & (V.H > 0) THEN RemoveMarks(V.X, V.Y, V.W, V.H);
  137.                             Display.ReplConst(Display.black, V.X, V.Y, V.W, V.H, Display.replace)
  138.                         ELSIF (M.id=Viewers.modify) & (M.Y < V.Y) THEN RemoveMarks(V.X, M.Y, V.W, V.Y-M.Y);
  139.                             Display.ReplConst(Display.black, V.X, M.Y, V.W, V.Y-M.Y, Display.replace)
  140.                         END
  141.                     END
  142.                 END
  143.             END
  144.         END HandleFiller;
  145.         PROCEDURE OpenDisplay*(UW, SW, H: INTEGER);
  146.             VAR Filler: Viewers.Viewer;
  147.         BEGIN
  148.             Input.SetMouseLimits(Viewers.curW+UW+SW, H);
  149.             Display.ReplConst(Display.black, Viewers.curW, 0, UW+SW, H, Display.replace); 
  150.             NEW(Filler); Filler.handle:=HandleFiller; Viewers.InitTrack(UW, H, Filler); (*init user track*)
  151.             NEW(Filler); Filler.handle:=HandleFiller; Viewers.InitTrack(SW, H, Filler) (*init system track*)
  152.         END OpenDisplay;
  153.         PROCEDURE DisplayWidth*(X: INTEGER): INTEGER;
  154.         BEGIN RETURN DW
  155.         END DisplayWidth;
  156.         PROCEDURE DisplayHeight*(X: INTEGER): INTEGER;
  157.         BEGIN RETURN DH
  158.         END DisplayHeight;
  159.         PROCEDURE OpenTrack*(X, W: INTEGER);
  160.             VAR Filler: Viewers.Viewer;
  161.         BEGIN NEW(Filler); Filler.handle:=HandleFiller; Viewers.OpenTrack(X, W, Filler)
  162.         END OpenTrack;
  163.         PROCEDURE UserTrack*(X: INTEGER): INTEGER;
  164.         BEGIN RETURN X DIV DW*DW
  165.         END UserTrack;
  166.         PROCEDURE SystemTrack*(X: INTEGER): INTEGER;
  167.         BEGIN RETURN X DIV DW*DW+DW DIV 8*5
  168.         END SystemTrack;
  169.         PROCEDURE UY(X: INTEGER): INTEGER;
  170.             VAR fil, bot, alt, max: Display.Frame;
  171.         BEGIN Viewers.Locate(X, 0, fil, bot, alt, max);
  172.             IF fil.H >= DH DIV 8 THEN RETURN DH ELSE RETURN max.Y+max.H DIV 2 END
  173.         END UY;
  174.         PROCEDURE AllocateUserViewer*(DX: INTEGER; VAR X, Y: INTEGER);
  175.         BEGIN
  176.             IF Pointer.on THEN X:=Pointer.X; Y:=Pointer.Y ELSE X:=DX DIV DW*DW; Y:=UY(X) END
  177.         END AllocateUserViewer;
  178.         PROCEDURE SY(X: INTEGER): INTEGER;
  179.             VAR fil, bot, alt, max: Display.Frame;
  180.         BEGIN Viewers.Locate(X, DH, fil, bot, alt, max);
  181.             IF fil.H >= DH DIV 8 THEN RETURN DH
  182.             ELSIF max.H >= DH-H0 THEN RETURN max.Y+H3
  183.             ELSIF max.H >= H3-H0 THEN RETURN max.Y+H2
  184.             ELSIF max.H >= H2-H0 THEN RETURN max.Y+H1
  185.             ELSIF max#bot THEN RETURN max.Y+max.H DIV 2
  186.             ELSIF bot.H >= H1 THEN RETURN bot.H DIV 2
  187.             ELSE RETURN alt.Y+alt.H DIV 2 END
  188.         END SY;
  189.         PROCEDURE AllocateSystemViewer*(DX: INTEGER; VAR X, Y: INTEGER);
  190.         BEGIN IF Pointer.on THEN X:=Pointer.X; Y:=Pointer.Y ELSE X:=DX DIV DW*DW+DW DIV 8*5; Y:=SY(X) END
  191.         END AllocateSystemViewer;
  192.         PROCEDURE MarkedViewer*(): Viewers.Viewer;
  193.         BEGIN RETURN Viewers.This(Pointer.X, Pointer.Y)
  194.         END MarkedViewer;
  195.         PROCEDURE PassFocus*(V: Viewers.Viewer);
  196.             VAR M: ControlMsg;
  197.         BEGIN M.id:=defocus; FocusViewer.handle(FocusViewer, M); FocusViewer:=V
  198.         END PassFocus;
  199.     (* Command Interpretation *)
  200.         PROCEDURE Call*(name: ARRAY OF CHAR; par: ParList; new: BOOLEAN; VAR res: INTEGER);
  201.             VAR Mod: Modules.Module; P: Modules.Command; i, j: INTEGER;
  202.         BEGIN res:=1; i:=0; j:=0;
  203.             WHILE name[j]#0X DO
  204.                 IF name[j]="." THEN i:=j END;
  205.                 INC(j)
  206.             END;
  207.             IF i > 0 THEN name[i]:=0X;
  208.                 IF new THEN Modules.Free(name, FALSE) END;
  209.                 Mod:=Modules.ThisMod(name);
  210.                 IF Modules.res=0 THEN INC(i); j:=i;
  211.                     WHILE name[j]#0X DO name[j-i]:=name[j]; INC(j) END;
  212.                     name[j-i]:=0X; P:=Modules.ThisCommand(Mod, name);
  213.                     IF Modules.res=0 THEN Par:=par;
  214.                         IF par#MPar THEN Par.vwr:=Viewers.This(par.frame.X, par.frame.Y) END;
  215.                         P; res:=0
  216.                     ELSE res:=Modules.res END
  217.                 ELSE res:=Modules.res END
  218.             ELSE res:=-1 END
  219.         END Call;
  220.         PROCEDURE GetSelection*(VAR text: Texts.Text; VAR beg, end, time: LONGINT);
  221.             VAR M: SelectionMsg;
  222.         BEGIN M.time:=-1; Viewers.Broadcast(M); time:=M.time;
  223.             IF M.time >= 0 THEN text:=M.text; beg:=M.beg; end:=M.end END
  224.         END GetSelection;
  225.         PROCEDURE* GC;
  226.         BEGIN IF ActCnt <= 0 THEN Kernel.GC; ActCnt:=BasicCycle END
  227.         END GC;
  228.         PROCEDURE Install*(T: Task);
  229.             VAR t: Task;
  230.         BEGIN t:=PrevTask;
  231.             WHILE (t.next#PrevTask)&(t.next#T) DO t:=t.next END;
  232.             IF t.next=PrevTask THEN T.next:=PrevTask; t.next:=T END
  233.         END Install;
  234.         PROCEDURE Remove*(T: Task);
  235.             VAR t: Task;
  236.         BEGIN t:=PrevTask;
  237.             WHILE (t.next#T) & (t.next#PrevTask) DO t:=t.next END;
  238.             IF t.next=T THEN t.next:=t.next.next; PrevTask:=t.next END;
  239.             IF CurTask=T THEN CurTask:=NIL END
  240.         END Remove;
  241.         PROCEDURE Collect*(count: INTEGER);
  242.         BEGIN ActCnt:=count
  243.         END Collect;
  244.         PROCEDURE SetFont*(fnt: Fonts.Font);
  245.         BEGIN CurFnt:=fnt
  246.         END SetFont;
  247.         PROCEDURE SetColor*(col: SHORTINT);
  248.         BEGIN CurCol:=col
  249.         END SetColor;
  250.         PROCEDURE SetOffset*(voff: SHORTINT);
  251.         BEGIN CurOff:=voff
  252.         END SetOffset;
  253.         PROCEDURE Loop*;
  254.             CONST SETUP1= 0F1X; SETUP2=00AX; ESC= 1BX;
  255.             VAR V: Viewers.Viewer; M: InputMsg; N: ControlMsg; prevX, prevY: INTEGER; X, Y: INTEGER; keys: SET; ch: CHAR; sp, sb: LONGINT;
  256.         BEGIN
  257.             sp:=SYSTEM.ADR (sp); sp:=SYSTEM.ADR (sb);
  258.             SYSTEM.GETREG (2, sb); SYSTEM.GETREG (1, sp);
  259.             Kernel.MarkState;
  260.             SYSTEM.PUTREG (2, sb); SYSTEM.PUTREG (1, sp);
  261.             LOOP
  262.                 Input.Mouse(keys, X, Y);
  263.                 IF Input.Available() > 0 THEN  Input.Read(ch);
  264.                     IF ch=ESC THEN N.id:=neutralize; Viewers.Broadcast(N); FadeCursor(Pointer)
  265.                     ELSIF (ch=SETUP1) OR (ch=SETUP2) THEN N.id:=mark; N.X:=X; N.Y:=Y; V:=Viewers.This(X, Y); V.handle(V, N)
  266.                     ELSE M.id:=consume; M.ch:=ch; M.fnt:=CurFnt; M.col:=CurCol; M.voff:=CurOff; FocusViewer.handle(FocusViewer, M); DEC(ActCnt)
  267.                     END
  268.                 ELSIF keys#{} THEN
  269.                     IF ~Macintosh.macEvent THEN M.id:=track; M.X:=X; M.Y:=Y; M.keys:=keys;
  270.                         REPEAT V:=Viewers.This(M.X, M.Y); V.handle(V, M); Input.Mouse(M.keys, M.X, M.Y) UNTIL M.keys={};
  271.                         DEC(ActCnt)
  272.                     END
  273.                 ELSE
  274.                     IF (X#prevX) OR (Y#prevY) OR ~Mouse.on THEN
  275.                         M.id:=track; M.X:=X; M.Y:=Y; M.keys:=keys; V:=Viewers.This(X, Y); V.handle(V, M); prevX:=X; prevY:=Y
  276.                     END;
  277.                     CurTask:=PrevTask.next;
  278.                     IF CurTask.time <= Input.Time() THEN
  279.                         IF ~CurTask.safe THEN PrevTask.next:=CurTask.next END;
  280.                         CurTask.handle;
  281.                         IF (CurTask # NIL) & (PrevTask.next # CurTask) THEN CurTask.next:=PrevTask.next; PrevTask.next:=CurTask END
  282.                     END;
  283.                     PrevTask:=PrevTask.next
  284.                 END
  285.             END
  286.         END Loop;
  287.         PROCEDURE* Backgrounder;
  288.         BEGIN CurTask:=PrevTask.next;
  289.             IF CurTask.time <= Input.Time() THEN
  290.                 IF ~CurTask.safe THEN PrevTask.next:=CurTask.next END;
  291.                 CurTask.handle;
  292.                 IF (CurTask # NIL) & (PrevTask.next # CurTask) THEN CurTask.next:=PrevTask.next; PrevTask.next:=CurTask END
  293.             END;
  294.             PrevTask:=PrevTask.next
  295.         END Backgrounder;
  296.         PROCEDURE* Neutralize;
  297.             VAR M: ControlMsg;
  298.         BEGIN M.id:=neutralize; Viewers.Broadcast(M); FadeCursor(Pointer)
  299.         END Neutralize;
  300.         PROCEDURE* Restore;
  301.             VAR M: Viewers.ViewerMsg;
  302.         BEGIN M.id:=Viewers.suspend; Viewers.Broadcast(M); M.id:=Viewers.restore; Viewers.Broadcast(M)
  303.         END Restore;
  304.         PROCEDURE* Commander;
  305.         BEGIN Call(Macintosh.cmdName, MPar, FALSE, Macintosh.qRes)
  306.         END Commander;
  307. BEGIN
  308.     Arrow.Fade:=FlipArrow; Arrow.Draw:=FlipArrow; arrowFade:=FlipArrow;
  309.     Star.Fade:=FlipStar; Star.Draw:=FlipStar;
  310.     OpenCursor(Mouse); Mouse.marker:=Arrow; OpenCursor(Pointer);
  311.     DW:=Display.Width; DH:=Display.Height; unitW:=DW DIV 8;
  312.     H4:=DH DIV 4; H3:=DH-DH DIV 3; H2:=H3-H3 DIV 2; H1:=DH DIV 5; H0:=DH DIV 10;
  313.     OpenDisplay(unitW*5, unitW*3, DH); Display.SetMode(0, {}); FocusViewer:=Viewers.This(0, 0);
  314.     NEW(MPar); MPar.vwr:=Viewers.This(0, 0); MPar.frame:=Viewers.This(0, 0); (*!Macintosh!*)
  315.     NEW(Log); Texts.Open(Log, ""); MPar.text:=Log; (*!Macintosh!*)
  316.     CurFnt:=Fonts.Default; CurCol:=Display.white;
  317.     Collect(BasicCycle);
  318.     NEW(PrevTask); PrevTask.handle:=GC; PrevTask.safe:=TRUE; PrevTask.next:=PrevTask;
  319.     Macintosh.neutralizeQ.Add (Neutralize);
  320.     Macintosh.restoreQ.Add (Restore);
  321.     Macintosh.suspendQ.Add (Neutralize);
  322.     Macintosh.backgroundQ.Add (Backgrounder);
  323.     Macintosh.cmdQ.Add (Commander);
  324.     SystemMod:=Modules.ThisMod("System")
  325. END Oberon.
  326.